sele 1
STORE 0 TO TPRIC,TPPRIC,THPRIC,TMEPRIC,TPHPRIC,CTRME,CTRPH,TMPRIC,TMSPRIC
F1='ME'+KDPAT
CNTME=RECCOUNT()
SET EXCLU OFF
USE &DR&F1
SELE 2
F2='ACT_PROC'    &&&    * 'act_proc'
SET EXCLU OFF
USE &DR&F2
SELE 3
F3='PH'+KDPAT
CNTPH=RECCOUNT()
SET EXCLU OFF
USE &DR&F3
SELE 4
F4='ACT_PHAR'    &&&    * 'act_phar'
SET EXCLU OFF
USE &DR&F4
SELE 5
F5='DOCT_FEE'    &&&    * 'doct_fee'
SET EXCLU OFF
USE &DR&F5
SELE 6
F6='ACTIVITY'    &&&    * 'activity'
SET EXCLU OFF
USE &DR&F6
SELE 7
F7='REVENUE'     &&&    * 'revenue'
SET EXCLU OFF
USE &DR&F7
SELE 8
F8='IN_PAT'
SET EXCLU OFF
USE &DR&F8
LOCA FOR PAT_FILCOD=KDPAT
DO WHILE .T.
   IF .NOT. FOUND()
      CONTINUE
      LOOP
   ELSE
      NMPAT=PAT_NAME
      FNMPAT=PAT_F_NAME
      MNMPAT=PAT_M_INIT
      ISEX=PAT_SEX
      DOB=PAT_DOB
      COPAT=PAT_CODCRP
      CRPAT=PAT_CODCRE
      DTPAT=PAT_CODDAT
      TPPAT=PAT_CODTYP
      HEALTH=HEALTHLINE
      MEDS=MED_SCHEME
      DENTAL=HL_DENT
      CORP=JOB_CORP
      IF REC_LOCK()
         DELE
      ENDIF
      UNLOCK
      EXIT
   ENDIF
ENDDO
SELE 1
go top
DO WHILE .NOT. EOF()
   NPROC=NPROC+1
   DOCFEE=COST_ALLO1
   SUNPC=SUN_PC
   PUB=PUB_PRICE
   PPAY=PROC_PAY
   PHL=PROC_HL
   PMS=PROC_MS
   HLRES=HEALTHLINE
   MSRES=MED_SCHM
   AREA=AREA_CODE
   SUBAREA=SUB_AREACO
   PROCODE=PRO_CODE
   DESCR=SHRT_DESCR
   NUMB=PROC_X
   MAINAR=MAIN_AREA
   KUNCI=AREA_CODE+SUB_AREACO
   KUN=AREA+SUBAREA+PROCODE
   NDOCT=DOC_ALIAS
   CDOCT=DOC_CODE
   CIT = LABT_CITO
   
   IF CIT
      IF KUN<>'L910' .AND. KUN<>'L911' .AND. KUN<>'L945' .AND. KUN<>'L946'
         PUB=PUB+((PUB*20)/100)
      ELSE
         PUB=PUB*2
      ENDIF
   ENDIF
   
   PRIC=PUB*NUMB
   TPRIC=TPRIC+PRIC
   TPPRIC=TPPRIC+PPAY
   THPRIC=THPRIC+PHL
   TMPRIC=TMPRIC+PMS
   TMEPRIC=TMEPRIC+PRIC
   CTRME=CTRME+1

   
   
   IF CDOCT<>SPACE(3)
      SELE 5
      IF FIL_LOCK(0)
         APPEN BLANK
      ENDIF
      IF REC_LOCK(0)
         REPL PAT_FILCOD WITH KDPAT,PAT_CODTYP WITH TPPAT,PAT_NAME WITH NMPAT,PAT_F_NAME WITH FNMPAT,PAT_M_INIT WITH MNMPAT
         REPL DATE_VISIT WITH DATE(),PROC_NBER WITH STR(NPROC,2),AREA_CODE WITH AREA,SUB_AREACO WITH SUBAREA
         REPL PRO_CODE WITH  PROCODE,SHRT_DESCR WITH DESCR,PROC_X WITH NUMB, PUB_PRICE WITH PUB
         REPL PROC_PAY WITH PPAY, TOT_PRICE WITH PRIC,DOC_CODE WITH CDOCT, DOC_ALIAS WITH NDOCT,DOC_FEE WITH DOCFEE, INV_NBER WITH NOFT
         REPL PAT_JAPAN WITH PATJAPAN,PAT_CMS WITH CMS
         REPL INV_STAT WITH KPIX
      ENDIF
      UNLOCK
   ENDIF
   SELE 2
   IF FIL_LOCK(0)
      APPEND BLANK
   ENDIF
   IF REC_LOCK(0)
      REPL PAT_FILCOD WITH KDPAT,PAT_CODTYP WITH TPPAT,DATE_VISIT WITH DATE()
      REPL PROC_NBER WITH STR(NPROC,2),AREA_CODE WITH AREA,SUB_AREACO WITH SUBAREA, PRO_CODE WITH  PROCODE
      REPL SHRT_DESCR WITH DESCR,DOC_CODE WITH CDOCT,PROC_PAY WITH PPAY, PROC_HL WITH PHL,PROC_MS WITH PMS,MED_SCHM WITH MSRES
      REPL HEALTHLINE WITH HLRES,PUB_PRICE WITH PUB,TOT_PRICE WITH PRIC, PROC_X WITH NUMB, INV_NBER WITH NOFT
      REPL PAT_JAPAN WITH PATJAPAN,PAT_CMS WITH CMS,LABT_CITO WITH CIT,SUN_PC WITH SUNPC
      REPL INV_STAT WITH KPIX
   ENDIF
   UNLOCK
   SELE 1
   SKIP
ENDDO
SELE 3
go top
DO WHILE .NOT. EOF()
   PHAR=PHAR_CODE
   PHNM=PHAR_NAME
   PHTP=PHAR_TYPE
   QANT=PHAR_QANT
   MSRES=MED_SCHM
   HLRES=HEALTHLINE
   PPAY=PHAR_PAY
   PHL=PHAR_HL
   PMS=PHAR_MS
   PUB=SALE_PRICE
   PHUN=PHAR_UNIT
   SEUN=SELL_UNIT
   NPHAR=NPHAR+1
   PRIC=PHAR_PRICE
   TPRIC=TPRIC+PRIC
   TPHPRIC=TPHPRIC+PRIC
   CTRPH=CTRPH+1
   TPPRIC=TPPRIC+PPAY
   THPRIC=THPRIC+PHL
   TMPRIC=TMPRIC+PMS
   PHX=PHAR_X
   SELE 4
   IF FIL_LOCK(0)
      APPEND BLANK
   ENDIF
   IF REC_LOCK(0)
      REPL PAT_FILCOD WITH KDPAT,PAT_CODTYP WITH TPPAT,phar_price with pric,DATE_VISIT WITH DATE()
      REPL PHAR_NBER WITH STR(NPHAR,2),PHAR_CODE WITH PHAR,PHAR_X WITH PHX,PHAR_PAY WITH PPAY,PHAR_HL WITH PHL
      REPL HEALTHLINE WITH HLRES,SALE_PRICE WITH PUB, INV_NBER WITH NOFT,phar_sale with phx*pub,MED_SCHM WITH MSRES,PHAR_MS WITH PMS
      REPL PAT_JAPAN WITH PATJAPAN,PAT_CMS WITH CMS
      REPL INV_STAT WITH KPIX
   ENDIF
   UNLOCK
   SELE 3
   SKIP
ENDDO
SELE 6
IF FIL_LOCK(0)
   APPEND BLANK
ENDIF
IF REC_LOCK(0)
   REPL PAT_FILCOD WITH KDPAT,PAT_NAME WITH NMPAT,PAT_F_NAME WITH FNMPAT, PAT_M_INIT WITH MNMPAT
   REPL PAT_SEX WITH ISEX, PAT_DOB WITH DOB,PAT_CODCRP WITH COPAT,PAT_CODCRE WITH CRPAT, PAT_CODDAT WITH DTPAT
   REPL PAT_CODTYP WITH TPPAT,HEALTHLINE WITH HEALTH,HL_DENT WITH DENTAL,MED_SCHM WITH MEDS,DATE_VISIT WITH DATE()
   REPL INV_NBER WITH NOFT,TOTAL_FEE WITH TPRIC,TOTAL_PROC WITH TMEPRIC,TOTAL_PHAR WITH TPHPRIC,PAT_CORP WITH CORP
   REPL PAT_JAPAN WITH PATJAPAN,PAT_CMS WITH CMS
   REPL CASH_NAME WITH USERNM
   REPL INV_STAT WITH KPIX
ENDIF
UNLOCK

SELE 7
IF FIL_LOCK(0)
   APPEND BLANK
ENDIF
IF REC_LOCK(0)
   REPL PAT_FILCOD WITH KDPAT,PAT_NAME WITH NMPAT,PAT_F_NAME WITH FNMPAT,PAT_CODTYP WITH TPPAT
   REPL HEALTHLINE WITH HEALTH,HL_DENT WITH DENTAL,DATE_VISIT WITH DATE(),MED_SCHM WITH MEDS,TOTAL_MS WITH TMPRIC
   REPL INV_NBER WITH NOFT,TOTAL_FEE WITH TPRIC,TOTAL_PROC WITH TMEPRIC, TOTAL_PHAR WITH TPHPRIC
   REPL TOTAL_PAY WITH TPPRIC,TOTAL_HL WITH THPRIC,PAY_MODE WITH PAYMODE,PAY_ON WITH PAYON,PAY_NBER WITH PAYNBER
   REPL PAT_JAPAN WITH PATJAPAN
   REPL CASH_NAME WITH USERNM
   REPL OTHE_CURR WITH OTCUR
   REPL OTHE_AMNT WITH OTAMT
   REPL RATE_CURR WITH OTRAT
   REPL RECE_USD WITH UCKAS
   REPL RECE_RMB WITH CKAS
   REPL CHAN_AMNT WITH CHAN
   REPL TOTAL_DISP WITH CTRPH
*   REPL CHAN_CURR WITH
*   REPL CHAN_AMNT WITH CHAN
*   REPL CHAN_RATE WITH
*  REPL CHAN_OPER WITH
   REPL INV_STAT WITH KPIX
   DO CASE
   CASE PILC=1 .OR. PILC=4 .OR. PILC=6
      REPL TOTAL_CASH WITH 0, TOTAL_CRED WITH TPPRIC
   CASE PILC=3 .or. pilc=11
      REPL TOTAL_CASH WITH TPPRIC, TOTAL_CRED WITH 0
   CASE PILC=2
      REPL TOTAL_CASH WITH PARTCASH, TOTAL_CRED WITH PARTCRED
   OTHER
      REPL TOTAL_CASH WITH 0, TOTAL_CRED WITH 0
   ENDCASE
ENDIF
UNLOCK